home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / DELPHI32 / DISK_UTL / SHOWMAN / LOGOMAIN.PAS < prev    next >
Pascal/Delphi Source File  |  1996-05-25  |  8KB  |  297 lines
  1. unit LogoMain;
  2.  
  3. {
  4. Program to show disk usage as a pie-chart
  5.  
  6. Revision history:
  7.  
  8. 1.0    1993 Feb 08  First version for Boralnd's Turbo Pascal for Windows
  9. 2.0.0  1996 Apr 14  Version for Borland's Delphi 2.0
  10. 2.0.2  1996 Apr 16  Pre-load Open dialog with '*.*' file name
  11.                     Add number of files and directories display
  12. 2.0.4  1996 May 26  Add E-mail address to About box
  13. }
  14.  
  15. interface
  16.  
  17. uses Windows, Classes, Graphics, Forms, Controls, Menus,
  18.   Dialogs, StdCtrls, Buttons, ExtCtrls, ComCtrls, PieChart,
  19.   FileInfo;
  20.  
  21. type
  22.   TMainForm = class(TForm)
  23.     MainMenu: TMainMenu;
  24.     FileMenu: TMenuItem;
  25.     FileOpenItem: TMenuItem;
  26.     FileExitItem: TMenuItem;
  27.     OpenDialog: TOpenDialog;
  28.     Help1: TMenuItem;
  29.     AboutItem: TMenuItem;
  30.     SpeedPanel: TPanel;
  31.     OpenBtn: TSpeedButton;
  32.     ExitBtn: TSpeedButton;
  33.     StatusBar: TStatusBar;
  34.     PieChart1: TPieChart;
  35.     ListBox1: TListBox;
  36.     Timer1: TTimer;
  37.     btnStop: TButton;
  38.     BitBtn1: TBitBtn;
  39.     btnUp: TButton;
  40.     View1: TMenuItem;
  41.     Options1: TMenuItem;
  42.     Refresh1: TMenuItem;
  43.     N2: TMenuItem;
  44.     procedure FormCreate(Sender: TObject);
  45.     procedure FileExit(Sender: TObject);
  46.     procedure FileOpen(Sender: TObject);
  47.     procedure About(Sender: TObject);
  48.     procedure ShowHint(Sender: TObject);
  49.     procedure FormDestroy(Sender: TObject);
  50.     procedure Timer1Timer(Sender: TObject);
  51.     procedure PieChart1DblClick(Sender: TObject);
  52.     procedure ListBox1DblClick(Sender: TObject);
  53.     procedure btnStopClick(Sender: TObject);
  54.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  55.     procedure btnUpClick(Sender: TObject);
  56.     procedure Options1Click(Sender: TObject);
  57.     procedure Refresh1Click(Sender: TObject);
  58.   private
  59.     dir_list: TDirectoryList;
  60.     scanning: boolean;
  61.     stop_requested: boolean;
  62.     show_allocated: boolean;
  63.     procedure scan_tree;
  64.     procedure display_list (const list: TDirectoryList);
  65.     procedure handle_double_click (entry: TDirectoryData);
  66.   public
  67.     { Public declarations }
  68.   end;
  69.  
  70. procedure set_status_text (const s: string);  stdcall;
  71.  
  72. var
  73.   MainForm: TMainForm;
  74.  
  75. implementation
  76.  
  77. uses SysUtils, About, LogoStrs, OptnDlg;
  78.  
  79. const
  80.   product_name = 'David''s ShowMan program';
  81.   product_version = 'Version 2.0.4';
  82.   product_copyright = 'Copyright '#169' David J Taylor, Edinburgh, 1993-1996';
  83.   product_comments = 'Delphi 2.0 - 32-bit version'#10'david.taylor@gecm.com';
  84.  
  85. {$R *.DFM}
  86.  
  87. {$R version.res}
  88.  
  89. procedure set_status_text (const s: string);
  90. begin
  91.   MainForm.StatusBar.Panels[1].Text := s;
  92. end;
  93.  
  94. procedure TMainForm.FormCreate(Sender: TObject);
  95. begin
  96.   Application.OnHint := ShowHint;
  97.   dir_list := TDirectoryList.Create (nil, '.');
  98.   scanning := False;
  99.   stop_requested := False;
  100.   show_allocated := True;
  101.   Timer1.Enabled := True;
  102. end;
  103.  
  104. procedure TMainForm.FileOpen(Sender: TObject);
  105. begin
  106.   // rely on the OpenDialog function changing the current directory
  107.   with OpenDialog do
  108.     begin
  109.     FileName := '*.*';
  110.     if Execute then scan_tree;
  111.     end;
  112. end;
  113.  
  114. procedure TMainForm.FileExit(Sender: TObject);
  115. begin
  116.   Close;
  117. end;
  118.  
  119. procedure TMainForm.About(Sender: TObject);
  120. begin
  121.   with AboutBox do
  122.     begin
  123.     ProductName.Caption := product_name;
  124.     Version.Caption := product_version;
  125.     Copyright.Caption := product_copyright;
  126.     Comments.Caption := product_comments;
  127.     ProgramIcon.Picture.Icon := Application.Icon;
  128.     ShowModal;
  129.     end;
  130. end;
  131.  
  132. procedure TMainForm.ShowHint(Sender: TObject);
  133. begin
  134.   StatusBar.Panels[0].Text := Application.Hint;
  135. end;
  136.  
  137. procedure TMainForm.FormDestroy(Sender: TObject);
  138. begin
  139.   dir_list.Free;
  140. end;
  141.  
  142. procedure TMainForm.scan_tree;
  143. var
  144.   sectors_per_cluster: integer;
  145.   bytes_per_sector: integer;
  146.   free_clusters: integer;
  147.   total_clusters: integer;
  148.   cluster_bytes: integer;
  149.   disk: array [0..3] of char;
  150.   root: string;
  151. begin
  152.   if scanning then Exit;
  153.   PieChart1.Clear;
  154.   root := GetCurrentDir;
  155.   if root [Length (root)] <> '\' then root := root + '\';
  156.   StrPLcopy (disk, root, 3);
  157.   if not show_allocated
  158.   then cluster_bytes := 1
  159.   else if GetDiskFreeSpace (disk, sectors_per_cluster, bytes_per_sector,
  160.                             free_clusters, total_clusters)
  161.        then cluster_bytes := bytes_per_sector * sectors_per_cluster
  162.        else cluster_bytes := 1;
  163.   try
  164.     stop_requested := false;
  165.     btnStop.Enabled := True;
  166.     dir_list.SetDirectoryName (root);
  167.     scanning := true;
  168.     dir_list.scan (stop_requested, cluster_bytes, set_status_text);
  169.     display_list (dir_list);
  170.     scanning := false;
  171.     stop_requested := false;
  172.     btnStop.Enabled := False;
  173.   finally
  174.   end;
  175. end;
  176.  
  177. procedure TMainForm.Timer1Timer(Sender: TObject);
  178. begin
  179.   Timer1.Enabled := False;
  180.   if ParamCount > 0 then SetCurrentDir (ParamStr (1));
  181.   scan_tree;
  182. end;
  183.  
  184. procedure TMainForm.display_list (const list: TDirectoryList);
  185. var
  186.   str_list: TStringList;
  187.   index: integer;
  188.   size: integer;
  189.   total_size: integer;
  190.   s: string;
  191. begin
  192.   // prepare a string list with the sizes (numeric) and names
  193.   // of the files and directories in this part of the tree
  194.   str_list := TStringList.Create;
  195.   total_size := 0;
  196.   for index := 0 to list.Count-1 do
  197.     begin
  198.     size := TDirectoryData (list.Objects[index]).GetBytes;
  199.     Str (size, s);
  200.     str_list.AddObject (s + '   ' + LowerCase (list.Strings[index]),
  201.                         list.Objects[index]);
  202.     Inc (total_size, size);
  203.     end;
  204.   // compute and show the pie-chart
  205.   PieChart1.SetDataAndLabels (str_list);
  206.   str_list.Free;
  207.   // compute the status line
  208.   with list do
  209.     begin
  210.     StatusBar.Panels[1].Text :=
  211.       Format ('%s ... contains %1.n bytes in %1.n files and %1.n directories',
  212.       [GetDirectoryName, GetTotalBytes + 0.0,
  213.        GetTotalFiles + 0.0, GetTotalDirectories + 0.0]);
  214.     Caption := 'ShowMan - ' + GetDirectoryName;
  215.     btnUp.Enabled := GetParentDirectoryList <> nil;
  216.     end;
  217. end;
  218.  
  219. procedure TMainForm.PieChart1DblClick(Sender: TObject);
  220. var
  221.   lst: TDirectoryList;
  222. begin
  223.   handle_double_click (PieChart1.ClickedObject as TDirectoryData);
  224. end;
  225.  
  226. procedure TMainForm.ListBox1DblClick(Sender: TObject);
  227. var
  228.   entry: TDirectoryData;
  229. begin
  230.   entry := TDirectoryData (ListBox1.Items.Objects [ListBox1.ItemIndex]);
  231.   handle_double_click (entry);
  232. end;
  233.  
  234. procedure TMainForm.handle_double_click (entry: TDirectoryData);
  235. var
  236.   lst: TDirectoryList;
  237. begin
  238.   if entry <> nil then
  239.     with entry do
  240.       begin
  241.       lst := GetSubDirectoryList;
  242.       if lst <> nil
  243.       then
  244.         display_list (lst)
  245.       else
  246.         begin
  247.         lst := GetParentDirectoryList;
  248.         if lst <> nil then
  249.           display_list (lst)
  250.         end;
  251.       end;
  252. end;
  253.  
  254. procedure TMainForm.btnStopClick(Sender: TObject);
  255. begin
  256.   stop_requested := True;
  257. end;
  258.  
  259. procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  260. begin
  261.   stop_requested := True;
  262. end;
  263.  
  264. procedure TMainForm.btnUpClick(Sender: TObject);
  265. var
  266.   lst: TDirectoryList;
  267. begin
  268.   if ListBox1.Items.Count <> 0 then
  269.     with TDirectoryData (ListBox1.Items.Objects [0]) do
  270.     begin
  271.     lst := GetParentDirectoryList;
  272.     if lst <> nil then
  273.       display_list (lst)
  274.     end;
  275. end;
  276.  
  277. procedure TMainForm.Options1Click(Sender: TObject);
  278. begin
  279.   // use present setting of SHOW_ALLOCATED for the options dialog
  280.   OptionsDialog.show_allocated := show_allocated;
  281.   if OptionsDialog.ShowModal = mrOK then
  282.     if show_allocated <> OptionsDialog.show_allocated then
  283.       begin
  284.       // settings have changed, save the setting and re-scan
  285.       show_allocated := OptionsDialog.show_allocated;
  286.       scan_tree;
  287.       end;
  288. end;
  289.  
  290. procedure TMainForm.Refresh1Click(Sender: TObject);
  291. begin
  292.   scan_tree;
  293. end;
  294.  
  295. end.
  296.  
  297.